home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue41 / Construc / DRBOBNEW.1 < prev    next >
Encoding:
Text File  |  1998-12-02  |  2.3 KB  |  108 lines
  1. unit DrBobNEW;
  2. {$DEFINE DEBUG}
  3. interface
  4. uses
  5.   Classes, ScktComp;
  6.  
  7. type
  8.   TBNNTP = class(TComponent)
  9.   public
  10.     constructor Create(AOwner: TComponent); override;
  11.     destructor Destroy; override;
  12.   public
  13.     procedure Connect;
  14.   protected
  15.     _Socket: TClientSocket;
  16.     procedure SocketRead(Sender: TObject; Socket: TCustomWinSocket);
  17.     procedure SocketWrite(Sender: TObject; Socket: TCustomWinSocket);
  18.   private
  19.     fNewsServer: String;
  20.   published
  21.     property NewsServer: String read fNewsServer write fNewsServer;
  22.   private
  23.     LastSocket: TCustomWinSocket;
  24.     Status: String;
  25.   end;
  26.  
  27. implementation
  28. uses
  29.   SysUtils, Forms;
  30.  
  31. const
  32.   CmdStart =  0;
  33.   CmdList  =  1;
  34.   CmdQuit  = 42;
  35.  
  36. const
  37.   NNTP = 119;
  38.  
  39. const
  40.   CRLF = #13#10;
  41.  
  42. var
  43.   Command: Integer = CmdStart;
  44.  
  45. constructor TBNNTP.Create(AOwner: TComponent);
  46. begin
  47.   inherited Create(AOwner);
  48.   _Socket := TClientSocket.Create(Self);
  49.   _Socket.Port := NNTP;
  50.   _Socket.OnRead := SocketRead;
  51.   _Socket.OnWrite := SocketWrite;
  52.   LastSocket := nil
  53. end {Create};
  54.  
  55. destructor TBNNTP.Destroy;
  56. begin
  57.   _Socket.OnRead := nil;
  58.   if Assigned(LastSocket) then LastSocket.SendText('QUIT'+ CRLF);
  59.   _Socket.Free;
  60.   _Socket := nil;
  61.   inherited Destroy
  62. end {Destroy};
  63.  
  64. procedure TBNNTP.Connect;
  65. begin
  66.   Command := CmdStart;
  67.   _Socket.Active := False;
  68.   _Socket.Host := fNewsServer;
  69.   _Socket.Open;
  70.   repeat
  71.     Application.ProcessMessages
  72.   until Command >= CmdQuit;
  73. end {Connect};
  74.  
  75. procedure TBNNTP.SocketRead(Sender: TObject; Socket: TCustomWinSocket);
  76. begin
  77.   LastSocket := Socket; { talk back? }
  78.   Status := Socket.ReceiveText;
  79.   while (Length(Status) > 0) and (Status[Length(Status)] in [#10,#13]) do
  80.     Delete(Status,Length(Status),1);
  81. {$IFDEF DEBUG}
  82.   writeln(Status);
  83. {$ENDIF}
  84.   case Command of
  85.     CmdStart: Command := CmdList;
  86.     CmdList: Command := CmdQuit
  87.   end;
  88.   SocketWrite(Sender, Socket)
  89. end {SocketRead};
  90.  
  91. procedure TBNNTP.SocketWrite(Sender: TObject; Socket: TCustomWinSocket);
  92. var
  93.   Send: String;
  94. begin
  95.   Send := '';
  96.   case Command of
  97.     CmdList: Send := 'LIST';
  98.     CmdQuit: Send := 'QUIT'
  99.   end;
  100. {$IFDEF DEBUG}
  101.   if Send <> '' then writeln(Command,'> ',Send);
  102. {$ENDIF}
  103.   Socket.SendText(Send + CRLF)
  104. end {SocketWrite};
  105.  
  106. end.
  107.  
  108.